perm filename CLTCOM.LSP[E80,JMC] blob sn#534934 filedate 1980-09-15 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 examples for compiling from multiple output form to LISP
C00004 ENDMK
CāŠ—;
;;; examples for compiling from multiple output form to LISP
(defun substc (x y z n)
       (cond
	((atom z) n (cond ((= z y) x) (t z)))
	(t ((lambda (n1 w1)
		    ((lambda (n2 w2) n2 (cons w1 w2))
		     (substc x y (cdr z) n1)))
	    (substc x y (car z) (add1 n))))))

;;; The previous function expands (without optimization) to
(defun substc1 (w)
       (cond
	((atom (nth 2 w))
	 (append
	  (list (nth 3 w))
	  (cond
	   ((eq (nth 2 w) (nth 1 w)) (list (nth 0 w)))
	   (t (list (nth 2 w))))))
	(t ((lambda (w1)
		    ((lambda (w2)
			     (append
			      (list (nth 0 w2))
			      (list (cons (nth 1 w1) (nth 1 w2)))))
		     (substc1 (append
			       (list (nth 0 w))
			       (list (nth 1 w))
			       (list (cdr (nth 2 w)))
			       (list (nth 0 w1)))))) 
	    (substc1 (append
		      (list (nth 0 w))
		      (list (nth 1 w))
		      (list (car (nth 2 w)))
		      (list (add1 (nth 3 w)))))))))

;;; program to translate multi-output programs to single output programs
(defun ccom (f g) (putprop g (ccom1 f g (get f 'expr)) 'expr))